El conjunto de datos obtenidos abarca los resultados del Campeonato Mundial de Natación Kazán 2015, con los correspondientes datos de cada nadador y prueba.
Los datos han sido extraídos de Omega, la plataforma oficial de tiempos de la World Aquatics.
El conjunto de datos contiene información sobre los nadadores (fecha de nacimiento, país, id), y sobre la prueba nadada (tiempo de reacción, parciales, tiempo total, estilo, serie).
Según la descripción oficial de los datos, las variables que conforman el conjunto de datos son:
Primeramente, vamos a leer los datos:
datos2015<-read.csv("datos/2015_FINA.csv", header=TRUE, sep = ',')
Una vez nuestro programa los ha leído, vamos a echar nuestro primer vistazo:
dim(datos2015)
## [1] 11423 22
Tenemos en total 11423 filas y 22 variables o columnas.
Veámos la primera ocurrencia de nuestra tabla:
head(datos2015,1)
## athleteid lastname firstname birthdate gender name code eventid heat lane
## 1 100784 BORSHI NOEL 1996-02-13 F Albania ALB 1 1 4
## points reactiontime swimtime split cumswimtime splitdistance daytime round
## 1 680 0.77 63.65 1 29.63 50 930 PRE
## distance relaycount stroke splitswimtime
## 1 100 1 FLY 29.63
Observamos Noel Borshi, nadadora albanesa nacida un 13 de febrero de 1996, que tiene como id el número (100784). Noel Borshi nadó la prueba 1 en la serie 1 y carril 4. Nadó el 100m Mariposa en la ronda preliminar con un tiempo final de 63.65s y pasó por el primer parcial (50m) en 29.63 segundos.
A continuación, vamos a ver un resumen de los datos:
summary(datos2015)
## athleteid lastname firstname birthdate
## Min. :100392 Length:11423 Length:11423 Length:11423
## 1st Qu.:101501 Class :character Class :character Class :character
## Median :103266 Mode :character Mode :character Mode :character
## Mean :106980
## 3rd Qu.:110718
## Max. :125573
##
## gender name code eventid
## Length:11423 Length:11423 Length:11423 Min. : 1.00
## Class :character Class :character Class :character 1st Qu.: 13.00
## Mode :character Mode :character Mode :character Median : 30.00
## Mean : 53.15
## 3rd Qu.: 39.00
## Max. :428.00
##
## heat lane points reactiontime
## Min. : 1.00 Min. :0.000 Min. : 52.0 Min. :0.4200
## 1st Qu.: 1.00 1st Qu.:2.000 1st Qu.: 783.0 1st Qu.:0.6800
## Median : 3.00 Median :4.000 Median : 853.0 Median :0.7200
## Mean : 3.08 Mean :4.485 Mean : 826.6 Mean :0.7205
## 3rd Qu.: 4.00 3rd Qu.:7.000 3rd Qu.: 902.0 3rd Qu.:0.7600
## Max. :12.00 Max. :9.000 Max. :1028.0 Max. :0.9700
## NA's :71 NA's :61
## swimtime split cumswimtime splitdistance
## Min. : 21.19 Min. : 1.000 Min. : 21.19 Min. : 50.0
## 1st Qu.: 114.10 1st Qu.: 1.000 1st Qu.: 49.45 1st Qu.: 50.0
## Median : 231.31 Median : 3.000 Median : 99.36 Median : 150.0
## Mean : 366.11 Mean : 6.296 Mean : 197.01 Mean : 314.8
## 3rd Qu.: 523.24 3rd Qu.: 8.000 3rd Qu.: 255.23 3rd Qu.: 400.0
## Max. :1137.27 Max. :30.000 Max. :1137.27 Max. :1500.0
## NA's :59 NA's :59
## daytime round distance relaycount
## Min. : 930 Length:11423 Min. : 50.0 Min. :1
## 1st Qu.:1000 Class :character 1st Qu.: 200.0 1st Qu.:1
## Median :1048 Mode :character Median : 400.0 Median :1
## Mean :1192 Mean : 580.5 Mean :1
## 3rd Qu.:1117 3rd Qu.: 800.0 3rd Qu.:1
## Max. :1943 Max. :1500.0 Max. :1
##
## stroke splitswimtime
## Length:11423 Min. : 21.19
## Class :character 1st Qu.: 29.10
## Mode :character Median : 30.82
## Mean : 31.02
## 3rd Qu.: 32.77
## Max. :101.02
## NA's :59
De aquí, podemos obsevar que tenemos algunos valores nulos (NA’s), además se puede observar que, durante toda la competición, como máximo hubo 12 series y como mínimo 1. Que la piscina disponía de 10 carriles numerados del 0 al 9. También observamos que se nadaron pruebas de 50 y hasta 1500 metros.
Observamos que tenemos algunas variables categóricas, luego vamos a cargar la libreria “dyplr” y vamos a intentar visualizarlas de una mejor manera:
datos2015<- datos2015 %>% convert_as_factor(gender,name,code,round,heat,lane,stroke)
Bien, ahora, visualicemos otra vez el resumen:
summary(datos2015)
## athleteid lastname firstname birthdate
## Min. :100392 Length:11423 Length:11423 Length:11423
## 1st Qu.:101501 Class :character Class :character Class :character
## Median :103266 Mode :character Mode :character Mode :character
## Mean :106980
## 3rd Qu.:110718
## Max. :125573
##
## gender name code eventid heat
## F:5236 United States: 755 USA : 755 Min. : 1.00 1 :3181
## M:6187 China : 507 CHN : 507 1st Qu.: 13.00 2 :2297
## Australia : 479 AUS : 479 Median : 30.00 3 :1838
## Great Britain: 462 GBR : 462 Mean : 53.15 4 :1561
## Germany : 411 GER : 411 3rd Qu.: 39.00 5 :1317
## Italy : 382 ITA : 382 Max. :428.00 6 : 439
## (Other) :8427 (Other):8427 (Other): 790
## lane points reactiontime swimtime
## 4 :1303 Min. : 52.0 Min. :0.4200 Min. : 21.19
## 6 :1269 1st Qu.: 783.0 1st Qu.:0.6800 1st Qu.: 114.10
## 5 :1247 Median : 853.0 Median :0.7200 Median : 231.31
## 2 :1246 Mean : 826.6 Mean :0.7205 Mean : 366.11
## 3 :1215 3rd Qu.: 902.0 3rd Qu.:0.7600 3rd Qu.: 523.24
## 7 :1202 Max. :1028.0 Max. :0.9700 Max. :1137.27
## (Other):3941 NA's :71 NA's :61 NA's :59
## split cumswimtime splitdistance daytime round
## Min. : 1.000 Min. : 21.19 Min. : 50.0 Min. : 930 FIN:1475
## 1st Qu.: 1.000 1st Qu.: 49.45 1st Qu.: 50.0 1st Qu.:1000 PRE:8904
## Median : 3.000 Median : 99.36 Median : 150.0 Median :1048 SEM:1022
## Mean : 6.296 Mean : 197.01 Mean : 314.8 Mean :1192 SOP: 4
## 3rd Qu.: 8.000 3rd Qu.: 255.23 3rd Qu.: 400.0 3rd Qu.:1117 SOS: 18
## Max. :30.000 Max. :1137.27 Max. :1500.0 Max. :1943
## NA's :59
## distance relaycount stroke splitswimtime
## Min. : 50.0 Min. :1 BACK :1053 Min. : 21.19
## 1st Qu.: 200.0 1st Qu.:1 BREAST:1205 1st Qu.: 29.10
## Median : 400.0 Median :1 FLY :1095 Median : 30.82
## Mean : 580.5 Mean :1 FREE :6782 Mean : 31.02
## 3rd Qu.: 800.0 3rd Qu.:1 MEDLEY:1288 3rd Qu.: 32.77
## Max. :1500.0 Max. :1 Max. :101.02
## NA's :59
Bien, ahora podemos observar muchas más cosas, observamos que las variables name y code toman absolutamente los mismos valores, luego seguramente podamos reducir en una variable el conjunto de datos. Vemos también que se nadaron pruebas de espalda, braza, mariposa, crol y estilos Individual. También observamos que las pruebas las disputaron hombres y mujeres. Podemos observar también que el menor tiempo de reacción fue de 0.42 y el mayor de 0.97.
Viendo los datos, observamos que cada nadador tiene en una prueba concreta, tantas filas como parciales tenía en esa prueba, luego es obvio que para conocer mejor algunas variables, vamos a necesitar limpiar los datos para que los elementos repetidos no nos estorben.
Lo primero que vamos a hacer, va a ser crear una nueva variable, llamada edad, ya que será más representativo que trabajar con la variable birthdate. La variable tendrá el valor numérico de la edad de cada participante en el momento del mundial. Es decir, el 24 de Julio de 2015.
datos2015$birthdate <- as.Date(datos2015$birthdate)
#Calculamos la edad
fechaKazan<- as.Date("2015-07-24")
datos2015$edad <- as.numeric(difftime(fechaKazan, datos2015$birthdate, units = "weeks")) %/% 52 # Convertir de semanas a años
Ahora, vamos a crear una nueva tabla en la cual vamos a obtener sólamente los nadadores (sin repetir) que participaron en la competición:
nadadoresParticipantes <- datos2015 %>%
distinct(athleteid, .keep_all = TRUE)
Bien, ahora, vamos a observar qué sucede con las edades:
summary(nadadoresParticipantes$edad)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 10.00 19.00 21.00 21.32 24.00 38.00
Observamos que la edad máxima fue de 38 años, la media fue de 21.32 años, y el participante con menos edad fue de 10 años. Además, el 50% de los participantes estaban entre 19 y 24 años de edad.
Nos puede resultar extraño que haya un nadador de 10 años de edad. Por tanto, procedemos a contrastar la información. De esta forma, podemos ver si de verdad existe este atleta o es un dato mal tomado de nuestra base de datos. Confirmamos la información, entre otras fuentes, con esta noticia, de la cual añadimos el enlace sobre la joven nadadora de 10 años. noticia
Confirmamos mediante su nombre, apellidos y edad, que la noticia se refiere a los datos que tenemos.
datos_edad_10 <- datos2015[datos2015$edad == 10, ]
datos_edad_10
## athleteid lastname firstname birthdate gender name code eventid heat
## 1353 114036 TAREQ ALZAIN 2005-04-14 F Bahrain BRN 29 1
## 1354 114036 TAREQ ALZAIN 2005-04-14 F Bahrain BRN 34 1
## lane points reactiontime swimtime split cumswimtime splitdistance daytime
## 1353 2 226 0.74 41.13 1 41.13 50 954
## 1354 6 291 0.72 35.78 1 35.78 50 930
## round distance relaycount stroke splitswimtime edad
## 1353 PRE 50 1 FLY 41.13 10
## 1354 PRE 50 1 FREE 35.78 10
Se trata de una nadadora de Bahrain que nadó el 50 mariposa y el 50 libres. Luego podemos concluir que es un dato atípico pero no es erróneo.
De acuerdo con esta nueva variable, vemos cómo se distribuyen las edades.
ggplot(nadadoresParticipantes, aes(x = edad)) +
geom_density() +
ggtitle("Distribución. Edades.")
La mayoría de los nadadores parecen tener entre 15 y 25 años, con un pico alrededor de los 20 años. Esto sugiere que los participantes en la competición están en su mayoría en la etapa juvenil o temprana adultez.
Veamos el número exacto de mujeres y hombres en la competición:
summary(nadadoresParticipantes$gender)
## F M
## 494 616
Luego, observamos que hay 616 hombres y 494 mujeres que participaron en los mundiales de Kazán 2015.
Observemos ahora cómo se distribuyen los hombres y las mujeres y sus respectivas edades:
ggplot(nadadoresParticipantes, aes(x = edad, colour = gender)) +
# Añadir la capa de la densidad de probabilidad.
geom_density()
Según observamos la gráfica observamos que la distribución está ligeramente desplazada a la derecha para los hombres, esto indica que los hombres tienden a ser mayores en promedio que las mujeres. Esta diferencia en la distribución de edades entre los géneros nos conduce a realizar distintos test estadísticos para confirmar si la diferencia realmente es significativa.
t.test(edad~gender,data=nadadoresParticipantes)
##
## Welch Two Sample t-test
##
## data: edad by gender
## t = -4.8835, df = 1042, p-value = 1.206e-06
## alternative hypothesis: true difference in means between group F and group M is not equal to 0
## 95 percent confidence interval:
## -1.6322652 -0.6965245
## sample estimates:
## mean in group F mean in group M
## 20.67814 21.84253
Hemos comparado las medias de edad entre mujeres (grupo F) y hombres (grupo M), tomando como hipótesis nula que las medias de edad entre mujeres y hombres son iguales, y cómo hipótesis alternativa que las medias de edad entre mujeres y hombres son diferentes. Aunque el resultado del t-test muestra que hay una diferencia estadísticamente significativa(el p-valor es muy pequeño) entre las edades medias de hombres y mujeres (aproximadamente 1.16 años), en términos prácticos, esta diferencia es relativamente pequeña. En este caso, puede no ser relevante en términos de la experiencia o desempeño de los nadadores.
No obstante, proseguimos en nuestro análisis exploratorio.
tabla1<-table(nadadoresParticipantes$edad>30,nadadoresParticipantes$gender)
chisq.test(tabla1)
##
## Pearson's Chi-squared test with Yates' continuity correction
##
## data: tabla1
## X-squared = 0.5219, df = 1, p-value = 0.47
Por el resultado del siguiente test aplicado,podemos concluir con que no hay asociación significativa: Dado que el p-valor es 0.47, entre ser mayor de 30 años y el género de los nadadores en nuestros datos. En términos sencillos,la edad no parece estar relacionada con el género de los nadadores en cuanto a si son mayores de 30 años.
tabla2<-table(nadadoresParticipantes$edad<20,nadadoresParticipantes$gender)
chisq.test(tabla2)
##
## Pearson's Chi-squared test with Yates' continuity correction
##
## data: tabla2
## X-squared = 16.173, df = 1, p-value = 5.78e-05
Hay una diferencia considerable entre las frecuencias observadas (cuántos hombres y mujeres son menores de 20 años) y las frecuencias esperadas bajo la hipótesis nula (que no hay asociación entre edad y género para menores de 20 años). Esto sugiere ir un paso más allá, ¿Hay más mujeres menores de edad que hombres menores de edad?
tabla3<-table(nadadoresParticipantes$edad<18,nadadoresParticipantes$gender)
chisq.test(tabla3)
##
## Pearson's Chi-squared test with Yates' continuity correction
##
## data: tabla3
## X-squared = 23.307, df = 1, p-value = 1.381e-06
Los resultados sugieren que el género y la minoría de edad si que están significativamente relacionados en nuestro conjunto de datos de nadadores. Esto podría tener implicaciones para el análisis del rendimiento y la participación en competiciones.
Veamos números,
tabla3
##
## F M
## FALSE 387 549
## TRUE 107 67
#Calcular los totales
totales <- colSums(tabla3)
#Calcular el porcentaje de nadadores menores de 18 años por género
porcentajes <- (tabla3[2, ] / totales) * 100
# fila 2 son los menores de 18
porcentajes
## F M
## 21.65992 10.87662
De esta forma, ya habiendo confirmado una diferencia significativa. Podemos ver, de manera más representativa, como existe el doble de proporción de mujeres menores de edad en comparación con los hombres. Dicho en otras palabras, 2 de cada 10 mujeres son menores de 18 años, mientras que esto sólo ocurre en 1 de cada 10 hombres.
Vamos a ver la cantidad de nadadores por país.
library(ggplot2)
library(ggimage)
library(countrycode)
# NUESTRA TABLA ES nadadoresParticipantes
# Agregar el código ISO de dos dígitos, DIRAS PORQUE NO USAS CODE ESQ EN R PONE QUE TIENE Q SER DE DOS ASIQ ES LO Q TOCA HAY Q CONVERTIR
#ASI LO PONE LA WEB
nadadoresParticipantes$iso2 <- countrycode(nadadoresParticipantes$name, "country.name", "iso2c")
## Warning: Some values were not matched unambiguously: Fina, Kosovo, Micronesia, Virgin Islands
#UY SALTA ERROR PARECE QUE EN FINA, KOSOVO,MICRONESIA Y VIRGIN ISLAND NO SABE HACERLO
#VEO TODOS LOS NOMBRES PA BICHEAR
nombres<- unique(nadadoresParticipantes$name) #NO REPETIR CLARO
print(nombres)
## [1] Albania Algeria Andorra
## [4] Angola Antigua & Barbuda Argentina
## [7] Armenia Aruba Australia
## [10] Austria Azerbaijan Bahamas
## [13] Bangladesh Barbados Burundi
## [16] Belgium Benin Bermuda
## [19] Bosnia-Herzegovina Belarus Bolivia
## [22] Botswana Brazil Bahrain
## [25] Brunei Bulgaria Burkina Faso
## [28] Central African Rep. Cambodia Canada
## [31] Cayman Islands Congo Chile
## [34] China Ivory Coast Cameroon
## [37] Cook Islands Colombia Comoros
## [40] Costa Rica Croatia Cuba
## [43] Curacao Cyprus Czech Republic
## [46] Denmark Djibouti Dominican Republic
## [49] Ecuador Egypt El Salvador
## [52] Spain Estonia Ethiopia
## [55] Faroe Islands Fiji Finland
## [58] Fina France Micronesia
## [61] Gabon Gambia Great Britain
## [64] Georgia Germany Ghana
## [67] Greece Grenada Guatemala
## [70] Guinea Guam Guyana
## [73] Haiti Hong Kong Honduras
## [76] Hungary Indonesia India
## [79] I. R. Iran Ireland Iraq
## [82] Iceland Israel Virgin Islands
## [85] Italy British Virgin Is. Jamaica
## [88] Jordan Japan Kazakhstan
## [91] Kenya Kyrgyzstan Korea
## [94] Kosovo Kuwait Laos PDR
## [97] Latvia Libya Saint Lucia
## [100] Lesotho Lebanon Liechtenstein
## [103] Lithuania Luxembourg Macau
## [106] Madagascar Morocco Malaysia
## [109] Malawi Moldova Maldives
## [112] Mexico Mongolia Marshall Islands
## [115] Fr. Yug. Rep. Macedonia Mali Malta
## [118] Montenegro Monaco Mozambique
## [121] Mauritius Myanmar Namibia
## [124] Nicaragua Netherlands Nepal
## [127] Nigeria Niger Northern Mariana Islands
## [130] Norway New Zealand Pakistan
## [133] Panama Paraguay Peru
## [136] Philippines Palestine Palau
## [139] Papua New Guinea Poland Portugal
## [142] DPR Korea Puerto Rico Qatar
## [145] Romania South Africa Russia
## [148] Rwanda Samoa Senegal
## [151] Seychelles Singapore Sierra Leone
## [154] Slovenia San Marino Serbia
## [157] Sudan Switzerland Suriname
## [160] Slovakia Sweden Swaziland
## [163] Syria Tanzania Tonga
## [166] Thailand Tajikistan Turkmenistan
## [169] Togo Chinese Taipei Trinidad &Tobago
## [172] Tunisia Turkey United Arab Emirates
## [175] Uganda Ukraine Uruguay
## [178] United States Uzbekistan Venezuela
## [181] Vietnam St. Vincent & Grenadines Yemen
## [184] Zambia Zimbabwe
## 185 Levels: Albania Algeria Andorra Angola Antigua & Barbuda ... Zimbabwe
#nombres problemáticos
manual <- data.frame(
nombre = c("Fina", "Kosovo", "Micronesia", "Virgin Islands"),
iso2 = c("FI", "XK", "FM", "VI")
)
# Agregar variable de continente como hace la pagina
nadadoresParticipantes$continent <- countrycode(nadadoresParticipantes$iso2, "iso2c", "continent")
#vuelve a fallar
#solo es XK(KOSOVO, Esta en europa para los catetos)
#manualmente el continente para Kosovo (XK)
nadadoresParticipantes <- nadadoresParticipantes %>%
mutate(continent = ifelse(iso2 == "XK", "Europe", continent))
#nadadores por país
resumen_paises <- nadadoresParticipantes %>%
group_by(name, iso2, continent) %>%
summarise(num_nadadores = n(), .groups = "drop") %>%
arrange(desc(num_nadadores)) # Ordenar por número de nadadores
##esto esta muy guay podemos usarlo pa mas cosas ya que ya esta hecho
resumen_paises
## # A tibble: 185 × 4
## name iso2 continent num_nadadores
## <fct> <chr> <chr> <int>
## 1 China CN Asia 39
## 2 United States US Americas 37
## 3 Italy IT Europe 31
## 4 Russia RU Europe 30
## 5 Australia AU Oceania 29
## 6 Germany DE Europe 27
## 7 Great Britain GB Europe 25
## 8 Brazil BR Americas 23
## 9 Japan JP Asia 23
## 10 France FR Europe 22
## # ℹ 175 more rows
#Crear un gráfico;metemos colores
paleta <- c("Americas" = "#0084ff", "Asia" = "#44bec7",
"Europe" = "#ffc300", "Oceania" = "#fa3c4c")
oda_bar <- resumen_paises %>%
ggplot(aes(x = reorder(name, num_nadadores), y = num_nadadores, fill = continent)) +
geom_flag(y = -10, aes(image = iso2), size = 0.05) +
geom_bar(stat = "identity") +
labs(title = "Participación de Nadadores por País",
subtitle = "Datos de nadadores en competiciones",
x = "País",
y = "Número de Nadadores") +
scale_fill_manual(values = paleta) + # colores personalizados
expand_limits(y = c(0, max(resumen_paises$num_nadadores) + 10)) + # Aumentar el límite superior
coord_flip() + # Para hacer el gráfico horizontal
theme_minimal()
# Imprimir el gráfico
print(oda_bar)
## Warning: Removed 4 rows containing missing values or values outside the scale range
## (`geom_image()`).
Vemos también este mismo gráfico, pero separando los países por continentes.
paleta <- c("Americas" = "#0084ff",
"Asia" = "#44bec7",
"Europe" = "#ffc300",
"Oceania" = "#fa3c4c")
oda_bar1 <- resumen_paises %>%
ggplot(aes(x = reorder(name, num_nadadores),
y = num_nadadores,
fill = continent)) +
geom_flag(y = -10, aes(image = iso2), size = 0.05) +
geom_bar(stat = "identity") +
labs(title = "Participación de Nadadores por País",
subtitle = "Datos de nadadores en competiciones",
x = "País",
y = "Número de Nadadores") +
scale_fill_manual(values = paleta) + # Colores personalizados
expand_limits(y = c(0, max(resumen_paises$num_nadadores) + 10)) + # Ajustar el límite superior
coord_flip() + # Gráfico horizontal
theme_minimal() +
facet_wrap(~ continent, scales = "free_y") # Separar por continentes
# Imprimir el gráfico
print(oda_bar1)
## Warning: Removed 4 rows containing missing values or values outside the scale range
## (`geom_image()`).
Como vemos, estos gráficos son poco interpretables debido a la gran cantidad de países. Por ello, realizaremos un gráfico reduciendo la dimensión, juntando en un grupo llamado ‘Otros’ a aquellos países con menos de 10 nadadores. añadirlo
paleta <- c("Americas" = "#0084ff",
"Asia" = "#44bec7",
"Europe" = "#ffc300",
"Oceania" = "#fa3c4c",
"Otros" = "#d3d3d3") # Color para 'Otros'
# Crear una nueva columna que agrupe países con menos de 10 nadadores en "Otros"
resumen_paises <- resumen_paises %>%
mutate(name_group = ifelse(num_nadadores < 10, "Otros", name))
# Crear el gráfico
oda_bar3 <- resumen_paises %>%
ggplot(aes(x = reorder(name_group, num_nadadores),
y = num_nadadores,
fill = continent)) +
geom_flag(y = -10, aes(image = iso2), size = 0.05,
data = subset(resumen_paises, name_group != "Otros")) + # Solo poner banderas a países específicos
geom_bar(stat = "identity") +
labs(title = "Participación de Nadadores por País",
subtitle = "Países con menos de 10 nadadores agrupados en 'Otros'",
x = "País",
y = "Número de Nadadores") +
scale_fill_manual(values = paleta) + # Colores personalizados
expand_limits(y = c(0, max(resumen_paises$num_nadadores) + 10)) + # Ajustar el límite superior
coord_flip() + # Gráfico horizontal
theme_minimal()
# Imprimir el gráfico
print(oda_bar3)
paleta <- c("Americas" = "#0084ff",
"Asia" = "#44bec7",
"Europe" = "#ffc300",
"Oceania" = "#fa3c4c")
# Crear el histograma de cantidad de nadadores por continente
histograma_nadadores <- resumen_paises %>%
ggplot(aes(x = continent, y = num_nadadores, fill = continent)) +
geom_bar(stat = "identity") + # Sumar cantidad de nadadores por continente
labs(title = "Cantidad de Nadadores por Continente",
x = "Continente",
y = "Número de Nadadores") +
scale_fill_manual(values = paleta) + # Colores personalizados por continente
theme_minimal()
# Imprimir el histograma
print(histograma_nadadores)
Como podemos observar en los gráficos, la mayor cantidad de nadadores
son de procedencia europea, continuando con Asia y Américas, y teniendo
baja proporción los nadadores de África y Oceanía. Nos preguntamos en
esta situación, si los Europeos tendrán los puestos más altos en el
ranking. Es decir, si existe una correlación entre el origen y los
puestos clasificatorios de mayor nivel.
LO DE ABAJO DA ERROR, HAY Q MIRAR PERO ESTARIA GUAY PA VER SI DONDE HAY MUCHOS NADADORES GANAN (COMO DEBERIA SER) O SI GANAN EN SITIOS DONDE HAY POKITOS :)))
# Añadir columna de continentes según el país
nadadoresParticipantes$continent <- countrycode(nadadoresParticipantes$iso2, "country.name", "continent")
## Warning: Some values were not matched unambiguously: AD, AE, AG, AL, AM, AO, AR, AT, AU, AW, AZ, BA, BB, BD, BE, BF, BG, BH, BI, BJ, BM, BN, BO, BR, BS, BW, BY, CA, CF, CG, CH, CI, CK, CL, CM, CN, CO, CR, CU, CW, CY, CZ, DE, DJ, DK, DO, DZ, EC, EE, EG, ES, ET, FI, FJ, FO, FR, GA, GB, GD, GE, GH, GM, GN, GR, GT, GU, GY, HK, HN, HR, HT, HU, ID, IE, IL, IN, IQ, IR, IS, IT, JM, JO, JP, KE, KG, KH, KM, KP, KR, KW, KY, KZ, LA, LB, LC, LI, LS, LT, LU, LV, LY, MA, MC, MD, ME, MG, MH, MK, ML, MM, MN, MO, MP, MT, MU, MV, MW, MX, MY, MZ, NA, NE, NG, NI, NL, NO, NP, NZ, PA, PE, PG, PH, PK, PL, PR, PS, PT, PW, PY, QA, RO, RS, RU, RW, SC, SD, SE, SG, SI, SK, SL, SM, SN, SR, SV, SY, SZ, TG, TH, TJ, TM, TN, TO, TR, TT, TW, TZ, UA, UG, UY, UZ, VC, VE, VG, VN, WS, YE, ZA, ZM, ZW
# Esta línea no funciona, lo pone todo a NA
# Agrupar por continente y calcular la correlación de puntuaciones
# correlacion_continentes <- nadadoresParticipantes %>%
# group_by(continent) %>%
# summarise(correlacion = cor(points, use = "complete.obs"))
#
# print(correlacion_continentes)
#
# # Crear un gráfico de dispersión de puntuaciones por continente
# ggplot(nadadoresParticipantes, aes(x = continent, y = puntos, color = continent)) +
# geom_jitter(width = 0.2, height = 0, size = 3, alpha = 0.6) + # Para visualizar mejor
# labs(title = "Distribución de Puntuaciones por Continente",
# x = "Continente",
# y = "Puntuaciones") +
# theme_minimal()
#Crear una nueva columna para clasificar por edad
nadadoresParticipantes <- nadadoresParticipantes %>%
mutate(grupo_edad = ifelse(edad < 18, "Menores de 18", "18 y más"))
#Resumir el número de participantes en cada prueba por grupo de edad(CODIGO DE GOOGLE)
resumen_pruebas <- nadadoresParticipantes %>%
group_by(grupo_edad , distance) %>% # Agrupar por grupo de edad y prueba(LO MIRO POR DISTANCIAS)
summarise(num_participantes = n(),.groups = "drop") %>% #Contar el número de participantes
ungroup() %>% # Quitar agrupación
arrange(grupo_edad, desc(num_participantes)) #Ordenar los resultados
# Mostrar el resumen
resumen_pruebas
## # A tibble: 12 × 3
## grupo_edad distance num_participantes
## <chr> <int> <int>
## 1 18 y más 100 405
## 2 18 y más 200 209
## 3 18 y más 50 179
## 4 18 y más 400 109
## 5 18 y más 800 21
## 6 18 y más 1500 13
## 7 Menores de 18 100 75
## 8 Menores de 18 50 45
## 9 Menores de 18 200 27
## 10 Menores de 18 400 19
## 11 Menores de 18 1500 5
## 12 Menores de 18 800 3
Tenemos la distancia de 100 metros, con 405 participantes. Es la distancia más popular entre los nadadores mayores de 18 años. Le sigue la distancia de 209 participantes, la de 200 metros. 200 metros: Con 209 participantes, sigue siendo una distancia muy popular. La participación disminuye considerablemente en distancias más largas, como 1500 metros con solo 13 participantes. Para los menores de 18 años tenemos carreras de 100 metros con 75 participantes, esta es la distancia más frecuentada, aunque significativamente menos que el grupo de 18 años o más. La participación en distancias más largas, como 400 metros, es aún más baja, con solo 19 participantes.
Los nadadores mayores de 18 años tienen una participación significativamente mayor en todas las distancias en comparación con los menores de 18 años. La mayor diferencia se observa en la distancia de 100 metros, donde hay 405 participantes en el grupo de 18 años o más, en comparación con solo 75 en el grupo de menores de edad. La participación en distancias más largas tiende a ser baja en ambos grupos, pero la caída es más pronunciada en los menores de 18.
Tratando de analizar los datos obtenidos podemos concluir con que la distancia de 100 metros es la más popular entre los nadadores. Sin embargo, la diferencia en el número de participantes entre ambos grupos de edad es significativa(más de 5 veces mayor entre los mayores de 18 años). Esta diferencia podría deberse a varios factores como la disponibilidad de competiciones para adultos o la preferencia de los nadadores más experimentados por distancias clásicas. Además, se observa una tendencia de disminución en la participación a medida que las distancias aumentan. Esto es común, ya que las distancias más largas suelen requerir más resistencia, y menos personas optan por competir en estas.
Primeramente, vamos a elaborar una tabla que refleje nadadores y pruebas nadadas (lo único que vamos a desechar son los parciales (filas) en caso de que la prueba sea de más de 50 metros.)
Para ello, primeramente debemos saber si cada prueba y cada tipo de prueba (preliminar, final o seminifinal), tiene un id de evento distinto, para ello seleccionamos algún nadador que haya nadado en la misma prueba varias rondas:
ejemplo<-datos2015[datos2015$distance == 100 & datos2015$stroke=="BACK" & datos2015$code=="AUS", ]
head(ejemplo,6)
## athleteid lastname firstname birthdate gender name code eventid heat
## 280 100529 LARKIN MITCHELL 1993-07-09 M Australia AUS 10 6
## 281 100529 LARKIN MITCHELL 1993-07-09 M Australia AUS 10 6
## 282 100529 LARKIN MITCHELL 1993-07-09 M Australia AUS 210 2
## 283 100529 LARKIN MITCHELL 1993-07-09 M Australia AUS 210 2
## 284 100529 LARKIN MITCHELL 1993-07-09 M Australia AUS 110 1
## 285 100529 LARKIN MITCHELL 1993-07-09 M Australia AUS 110 1
## lane points reactiontime swimtime split cumswimtime splitdistance daytime
## 280 5 968 0.59 52.50 1 25.34 50 949
## 281 5 968 0.59 52.50 2 52.50 100 949
## 282 4 975 0.67 52.38 1 25.28 50 1748
## 283 4 975 0.67 52.38 2 52.38 100 1748
## 284 4 973 0.57 52.40 1 25.41 50 1836
## 285 4 973 0.57 52.40 2 52.40 100 1836
## round distance relaycount stroke splitswimtime edad
## 280 PRE 100 1 BACK 25.34 22
## 281 PRE 100 1 BACK 27.16 22
## 282 SEM 100 1 BACK 25.28 22
## 283 SEM 100 1 BACK 27.10 22
## 284 FIN 100 1 BACK 25.41 22
## 285 FIN 100 1 BACK 26.99 22
Bien, vemos que el australiano nadó tanto las preliminares, como las semifinales como la final y el eventid era distinto, luego parece que podemos seguir con nuestro estudio:
nadadoresPruebas <- datos2015 %>%
distinct(eventid, athleteid, .keep_all = TRUE)
Los datos creados, reflejan nadadores y pruebas nadadas.
Veamos cómo se distribuyen los datos de tiempo de reacción de todos los nadadores:
ggplot(nadadoresPruebas, aes(x = reactiontime)) +
geom_density() +
ggtitle("Distribución. reactiontime")
## Warning: Removed 61 rows containing non-finite outside the scale range
## (`stat_density()`).
Parece que los datos siguen una distribución normal a priori. Vamos a ir más alla para intentar sacar conclusiones más profundas.
Vamos a comparar a comparar las funciones de densidad de chicos y chicas en general:
ggplot(nadadoresPruebas, aes(x=reactiontime, colour=gender))+
geom_density()+
ggtitle("Distribución. Hombres vs Mujeres")
De esta gráfica nos surgen muchas preguntas, vamos a analizar esto más a fondo. Hagamos un test de hipótesis donde:
t.test(reactiontime~gender,data=nadadoresParticipantes)
##
## Welch Two Sample t-test
##
## data: reactiontime by gender
## t = 6.531, df = 1007.8, p-value = 1.034e-10
## alternative hypothesis: true difference in means between group F and group M is not equal to 0
## 95 percent confidence interval:
## 0.01759253 0.03270509
## sample estimates:
## mean in group F mean in group M
## 0.7168238 0.6916750
De manera similar a antes, el p- valor nos indica que hay una evidencia significativa en rechazar la hipótesis nula, y por ende concluir con que hay una diferencia estadística en el tiempo de reacción dependiendo del género. Ahora que hemos determinado que la diferencia es estadísticamente significativa, es importante considerar si la diferencia es también significativa en la práctica o si tiene relevanciaa la hora de los resultados finales. Por ejemplo, de las mujeres/hombres que tienen un tiempo de reacción más bajo y aquellas/os que tienen un tiempo de reaccion más alto,¿ le corresponden puestos mas altos y bajos respectivamente? No podemos precipitarnos a decir que la diferencia es muy pequeña ya que habría que hacer un análisis adicional para medir la magnitud la diferencia (como el d de Cohen). Esto nos diría cómo es de grande la diferencia en términos de desviaciones estándar.
Vamos a comparar ahora las funciones de densidad de las chicas en la prueba de 800m libres y 50m libres:
Primeramente calculamos el conjunto de datos:
nadadorasComparacionReactionTime<-nadadoresPruebas[(nadadoresPruebas$distance==50 | nadadoresPruebas$distance==800) & nadadoresPruebas$gender=="F" & nadadoresPruebas$stroke=="FREE", ]
ggplot(nadadorasComparacionReactionTime, aes(x = reactiontime,group=distance)) +
geom_density() +
ggtitle("Distribución. Reaction time: 800m free vs 50m free")
## Warning: Removed 6 rows containing non-finite outside the scale range
## (`stat_density()`).
El gráfico muestra dos curvas de densidad superpuestas, una para la prueba de 50 metros y otra para 800 metros. Las curvas se encuentran en un rango de aproximadamente 0.6 a 0.9, que representa los tiempos de reacción. La advertencia en la consola indica que algunos valores fueron eliminados debido a ser no finitos, lo que sugiere que puede haber valores faltantes o outliers en los datos de tiempo de reacción. Para los 50 metros, la densidad es más alta en el rango de tiempos de reacción más cortos, lo que indica que las nadadoras tienden a tener tiempos de reacción más rápidos en esta distancia. Esto es esperado, ya que la carrera de 50 metros es más corta y requiere reacciones más rápidas y explosivas. En cuanto a la de 800 metros, la curva muestra una mayor dispersión en los tiempos de reacción, con una densidad más amplia. Esto sugiere que los tiempos de reacción son más variados en esta distancia, probablemente debido a la naturaleza más larga y estratégica de la carrera, donde las nadadoras pueden no necesitar un tiempo de reacción tan rápido.
Aquí también podemos hacer un test de hipótesis. Podemos comparar a los chicos para ver si es cierto lo supuesto
t.test(reactiontime~distance,data=nadadorasComparacionReactionTime)
##
## Welch Two Sample t-test
##
## data: reactiontime by distance
## t = -6.4017, df = 104.89, p-value = 4.41e-09
## alternative hypothesis: true difference in means between group 50 and group 800 is not equal to 0
## 95 percent confidence interval:
## -0.08030941 -0.04232486
## sample estimates:
## mean in group 50 mean in group 800
## 0.7078986 0.7692157
Veamos nuestros resultados del test. Por un lado tenemos el valor del estadístico t calculado, como es un valor negativo indica que la media del primer grupo (50 metros) es menor que la del segundo grupo (800 metros).El valor del p-valor (que es extremadamente bajo) indica que hay una diferencia estadísticamente significativa entre las medias de los dos grupos. Los nadadores que participan en distancias más cortas (50 metros) tienen un tiempo de reacción más rápido en comparación con aquellos que nadan distancias más largas (800 metros).Luego, habiamos identificado correctamente la tendencia del gráfico, en términos estadísticos.
A continuación, realizamos el mismo estudio pero con hombres y vemos si la situación es similar.
nadadoresComparacionReactionTime<-nadadoresPruebas[(nadadoresPruebas$distance==50 | nadadoresPruebas$distance==800) & nadadoresPruebas$gender=="M" & nadadoresPruebas$stroke=="FREE", ]
ggplot(nadadoresComparacionReactionTime, aes(x = reactiontime,group=distance)) +
geom_density() +
ggtitle("Distribución para Hombres. Reaction time: 800m free vs 50m free")
## Warning: Removed 6 rows containing non-finite outside the scale range
## (`stat_density()`).
Veamos cómo se distribuyen las calles usadas:
ggplot(nadadoresPruebas, aes(nadadoresPruebas$lane)) + geom_bar(fill = "orange") +
theme_bw()
## Warning: Use of `nadadoresPruebas$lane` is discouraged.
## ℹ Use `lane` instead.
Se observa que las calles menos usadas son tanto la 0 como la 9.
¿Habrá alguna relación entre la calle usada y el tiempo de reacción? Todo parece indicar que no. Veámoslo.
#me pareció guay este gráfico, alonso sabes interpretarlo? aupa
ggplot(nadadoresPruebas, aes(x = reactiontime, fill = lane)) +
geom_histogram(binwidth = 0.01, alpha = 0.7, position = "identity") +
facet_wrap(~ lane) + # Crear facetas por calle
theme_bw() +
labs(title = "Distribución de Tiempos de Reacción por Calle",
x = "Tiempo de Reacción",
y = "Frecuencia") +
scale_fill_brewer(palette = "Set1")
## Warning: Removed 61 rows containing non-finite outside the scale range
## (`stat_bin()`).
## Warning in RColorBrewer::brewer.pal(n, pal): n too large, allowed maximum for palette Set1 is 9
## Returning the palette you asked for with that many colors
Nos genera curiosidad, por su formato, cómo se distribuye daytime, luego veamos:
ggplot(nadadoresPruebas, aes(daytime)) + geom_bar(width=0.5, colour="red", fill="skyblue") + ggtitle("Daytime en los que se producen las pruebas")
Luego, podemos observar de manera clara que, cada día de competición constaba de 2 sesiones, una matinal y otra vespertina, y que las franjas horarias iban aproximadamente desde 930 (9:30 am) hasta las 1130 (MIRAR CÓMO HACER ESTE GRAFICO DE OTRA MANERA.)
##Estudios relacionados con los puntos. ´
Veamos las posibles relaciones de puntos con las demás variables:
Veamos ahora cómo se distribuyen los puntos:
ggplot(nadadoresPruebas, aes(x = points)) +
geom_density() +
ggtitle("Distribución. points")
## Warning: Removed 71 rows containing non-finite outside the scale range
## (`stat_density()`).
Observamos que la mayoría de puntos se encuentran a partir de los 750/800 puntos, y esto, tiene sentido si razonamos que para entrar a los mundiales de natación, se necesitan unas marcas mínimas (una cantidad de puntos preestablecida). Luego es normal encontrar una gran cantidad de datos que tengan más de 750 puntos ya que había un “corte” para la inscripción en la competición. Esto hace que la gráfica no esté más distribuida por todos los posibles valores de puntos.
Ahora nos surge la siguiente pregunta: ¿Quién rindió mejor en los campeonatos?.
Podemos buscar el nadador que hizo más puntos:
datos2015[which.max(datos2015$points), ]
## athleteid lastname firstname birthdate gender name code eventid
## 10614 105594 LEDECKY KATIE 1997-03-17 F United States USA 113
## heat lane points reactiontime swimtime split cumswimtime splitdistance
## 10614 1 4 1028 0.7 925.48 1 28.37 50
## daytime round distance relaycount stroke splitswimtime edad
## 10614 1805 FIN 1500 1 FREE 28.37 18
Observamos que la nadadora que cosechó más puntos en una prueba fue Katie Ledecky en los 1500 metros. Buscando, casualmente observamos que batió el récord[https://www.rtve.es/deportes/20150803/ledecky-bate-record-del-mundo-1500-libres/1193160.shtml] del mundo en dicha prueba.
Ahora, vamos a buscar al nadador que, en promedio, consiguió más puntos, podríamos denominarlo el MVP del Mundial Kazán 2015. Para ello:
#Usamos nadadoresPruebas, donde tenemos cada nadador y la prueba que realizó.
media_puntos <- aggregate(nadadoresPruebas$points ~ nadadoresPruebas$athleteid, data = nadadoresPruebas, FUN = mean)
media_puntos <- media_puntos[order(media_puntos$`nadadoresPruebas$points`, decreasing = TRUE), ]
media_puntos<- rename(media_puntos, "athleteid"="nadadoresPruebas$athleteid")
media_puntos<-rename(media_puntos, "meanPoints"="nadadoresPruebas$points")
head(media_puntos,5)
## athleteid meanPoints
## 666 108588 985.5714
## 452 102630 978.2857
## 554 105594 973.1111
## 222 101365 967.3333
## 76 100728 966.7500
El atleta con id 108588 es el que hizo más puntos, veamos quien es:
nadadoresPruebas[nadadoresPruebas$athleteid==108588 , ]
## athleteid lastname firstname birthdate gender name code eventid
## 1077 108588 PEATY ADAM 1994-12-28 M Great Britain GBR 6
## 1078 108588 PEATY ADAM 1994-12-28 M Great Britain GBR 206
## 1079 108588 PEATY ADAM 1994-12-28 M Great Britain GBR 106
## 1080 108588 PEATY ADAM 1994-12-28 M Great Britain GBR 14
## 1081 108588 PEATY ADAM 1994-12-28 M Great Britain GBR 214
## 1082 108588 PEATY ADAM 1994-12-28 M Great Britain GBR 114
## 1083 108588 PEATY ADAM 1994-12-28 M Great Britain GBR 26
## heat lane points reactiontime swimtime split cumswimtime splitdistance
## 1077 9 4 996 0.60 58.52 1 27.05 50
## 1078 2 4 1014 0.60 58.18 1 27.21 50
## 1079 1 4 996 0.59 58.52 1 27.20 50
## 1080 9 4 993 0.60 26.68 1 26.68 50
## 1081 1 4 1022 0.59 26.42 1 26.42 50
## 1082 1 4 1012 0.57 26.51 1 26.51 50
## 1083 5 5 866 0.61 133.24 1 29.77 50
## daytime round distance relaycount stroke splitswimtime edad
## 1077 1134 PRE 100 1 BREAST 27.05 20
## 1078 1835 SEM 100 1 BREAST 27.21 20
## 1079 1732 FIN 100 1 BREAST 27.20 20
## 1080 930 PRE 50 1 BREAST 26.68 20
## 1081 1748 SEM 50 1 BREAST 26.42 20
## 1082 1810 FIN 50 1 BREAST 26.51 20
## 1083 1033 PRE 200 1 BREAST 29.77 20
Luego, el MVP fue el británico Adam Peaty, que nadó 50, 100 y 200 braza. Veamos quiénes fueron los integrantes del podio:
nadadoresParticipantes[nadadoresParticipantes$athleteid==102630 | nadadoresParticipantes$athleteid==105594, ]
## athleteid lastname firstname birthdate gender name code
## 849 102630 VAN DER BURGH CAMERON 1988-05-25 M South Africa RSA
## 1046 105594 LEDECKY KATIE 1997-03-17 F United States USA
## eventid heat lane points reactiontime swimtime split cumswimtime
## 849 6 8 5 993 0.63 58.59 1 27.11
## 1046 5 5 4 964 0.69 241.73 1 27.79
## splitdistance daytime round distance relaycount stroke splitswimtime edad
## 849 50 1134 PRE 100 1 BREAST 27.11 27
## 1046 50 1103 PRE 400 1 FREE 27.79 18
## iso2 continent grupo_edad
## 849 ZA <NA> 18 y más
## 1046 US Americas 18 y más
Completaron el podio Cameron Van der Burgh, de Sudáfrica, y Katie Ledecky.
A continuación, vamos a comparar los puntos realizados por hombres y mujeres, para ver si podemos sacar alguna conclusión.
Primeramente, vamos a ver la función de densidad:
ggplot(nadadoresPruebas, aes(x = points, colour=gender)) +
geom_density() +
ggtitle("Distribución. Puntos por sexo")
## Warning: Removed 71 rows containing non-finite outside the scale range
## (`stat_density()`).
A priori, parece haber dos distribuciones muy igualadas.
SEGUIR AQUÍ CON EL ESTUDIO.
Una buena manera de medir el rendimiento con respecto a la edad del nadador, es verlo a través de los puntos obtenidos.
#QUERIA PONERLO CON COLORES Q SE VEA MEJOR EL GRAFICO DE CALOR(POR SER CREATIVOS Y TAL)
resumen_puntos <- nadadoresPruebas %>%
group_by(edad, points) %>%
summarise(frecuencia = n(), .groups = 'drop')
# Crear el gráfico de calor
ggplot(resumen_puntos, aes(x = edad, y = points)) +
geom_tile(aes(fill = frecuencia), color = "white") +
scale_fill_gradient(low = "pink", high = "red") +
theme_bw() +
labs(title = "Gráfico de Calor: Edades y Puntos Obtenidos",
x = "Edad",
y = "Puntos Obtenidos") +
theme(panel.grid.major = element_blank(),
panel.grid.minor = element_blank())
## Warning: Removed 17 rows containing missing values or values outside the scale range
## (`geom_tile()`).
###Estudio de puntos por país. Veamos el número de puntos por países
###Modelo de regresión lineal para tiempo de reaccion vs tiempo
# Esto no funciona porque las dos variables continuas tienen distinto tamaño
# Hay que gestionar los NAs previamente
# Además, como solo se está trabajando con dos variables continuas, no tiene sentido hacer pairs
# Realmente es un único plot
# pairs(nadadoresPruebas$points,splitswimtime)
poner aqui todo juntos en un pairs Empezamos viendo la relación lineal (que ya sabemos que será alta) entre puntos y tiempo. Es evidente que a mayor tiempo, hay menos puntos. Veámoslo
nadadoresPruebas50crol<- nadadoresPruebas[nadadoresPruebas$distance==50 & nadadoresPruebas$stroke=='FREE', ]
t= nadadoresPruebas50crol$swimtime
p= nadadoresPruebas50crol$points
cor(t,p)
## [1] NA
#verlo pero
Esto no es de mucho estudio, ya que es lo lógico.
Veamos los puntos respecto al tiempo de reacción:
nadadoresPruebas<- na.omit(nadadoresPruebas)
x= nadadoresPruebas$points
y=nadadoresPruebas$reactiontime
cor(x,y)
## [1] -0.2861291
Parecen no estar correlacionadas el tiempo de reaccion y los puntos de manera lineal. Pero a lo mejor, en pruebas específicas , como las pruebas de distancias cortas la correlación es mayor.
nadadoresPruebas50<- nadadoresPruebas[nadadoresPruebas$distance==50, ]
X=nadadoresPruebas50$reactiontime
Y=nadadoresPruebas50$points
cor(X,Y)
## [1] -0.5573374
Ya tenemos nuestro objetivo de estudio ya que para comenzar con la modelización estadística, debemos contextualizar el problema, definiendo objetivos y variables.
Queremos investigar si existe relación entre el tiempo de reacción y puntos. Una pregunta que puede surgirnos es, ¿A mayores valores del tiempo de reacción, hay mayores valores de puntos? Luego, nuestro objetivo será saber si hay algún tipo de relación lineal, y las variables, por ende, serán tiempo de reacción y puntos. La variable tiempo de reacción, será nuestra variable independiente, y puntos será la variable dependiente.
A continuación, procedemos a realizar una inspección gráfica simple, para identificar tendencias.
plot(X,Y,xlab="Tiempo de reacción",ylab="Puntos")
cov(X,Y)
## [1] -6.859023
Esta covarianza, positiva y grande en valor absoluto, nos indica que hay relación negativa entre las variables(ya lo habíamos intuido pero gracias al signo lo hemos confirmado).
A pesar de la confirmación, en este momento nos surge un problema, pues, la covarianza toma valores en todos los números reales, dependiendo de las magnitudes del tiempo de reacción y puntos, y de sus unidades . Por eso, calcularemos el coeficiente de correlación lineal, que se obtiene tipificando la covarianza, es decir, dividiendo la covarianza entre las desviaciones típicas muestrales (obteniendo un coeficiente entre -1 y 1)
cor(X,Y)
## [1] -0.5573374
De manera adicional, podemos incluir histogramas marginales en cada
eje del gráfico, para ello usamos las librerías ggplot2 y
ggExtra.
datos<-data.frame(x=X,y=Y)
p<-ggplot(datos, aes(x = X, y = Y)) +
geom_point()
#vemos la nube de puntos
print(p)
#Especificamos que se añadan histogramas en los márgenes
ggMarginal(p, type = "histogram")
Como hemos visto, si la relacion lineal es fuerte tiene sentido querer ajustar una recta a la nube de puntos. Es decir, considerar un modelo de regresion lineal simple.
La función que ajusta el modelo de regresión lineal simple en R es
lm(con parametros B_0,B_1 y sigma^2), directamente hacemos
un summary para que nos devuelva la información más
importante, aunque realmente lm calcula muchas cosas:
estimaciones, residuos, predicciones, etc.
lm=lm(Y~X)
summary(lm)
##
## Call:
## lm(formula = Y ~ X)
##
## Residuals:
## Min 1Q Median 3Q Max
## -495.9 -88.7 22.7 109.2 391.1
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 1809.05 55.43 32.64 <2e-16 ***
## X -1562.32 80.84 -19.33 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 154.3 on 829 degrees of freedom
## Multiple R-squared: 0.3106, Adjusted R-squared: 0.3098
## F-statistic: 373.5 on 1 and 829 DF, p-value: < 2.2e-16
Podemos añadir la recta de regresión al gráfico usando el comando
abline, y el objeto donde hemos guardado el ajuste de la
recta, en este caso lm4:
#representamos
plot(X,Y)
#añadimos la recta de regresion
abline(lm)
Los coeficientes de la regresión estimados también están en el objeto
donde hemos guardado el ajuste, en lm
#generamos un vector con los coeficientes de la regresion
coeficientes=lm$coefficients
#comprobamos que es lo mismo que nos salía en el summary
coeficientes
## (Intercept) X
## 1809.053 -1562.315
Sabemos que el valor de los puntos cuando X=0, es decir, que el tiempo de reacción sea cero, es de 1809 aproximadamente. Este parámetro no tendría sentido, pues el tiempo de reacción nunca va a ser cero. Por otro lado la pendiente es -1562.315, lo que nos muestra que por cada valor que aumenta X, Y aumenta lo indicado.
Una vez tenemos los coeficientes de la regresión estimados calculamos los residuos o errores de predicción.
ajuste= coeficientes[1]+coeficientes[2]*X
residuos=Y-ajuste
Nos falta ver la estimación de uno de nuestros parámetros de nuestro modelo, pero sabemos que si el modelo de regresión es bueno es posible conseguir una estimación de la varianza a partir de la suma de cuadrados residual SSE. En este caso, tenemos que las observaciones Yi provienen de diferentes poblaciones, porque tienen diferentes medias, pero con la misma varianza. Por lo tanto, el término de desviación va a estar medido por los residuos. Consideramos la suma al cuadrado de estos residuos, que sabemos que es mínima (SSE). Puesto que en el modelo de regresión lineal simple se estiman 2 parámetros, los grados de libertad asociados a SSE son n−2. Se define el cuadrado medio residual, MSE=s^2 , como un estimador de la varianza (sigma^2).
Pero el cuadrado medio residual también está en el objeto donde hemos
guardado el ajuste, en lm4
s=summary(lm)$sigma
MSE=s^2
MSE
## [1] 23810.79
#tenemos la recta ajustada:estimamos B_0, b_1 Y sigma^2
Para hacer inferencias consideramos la distribución en el muestreo de ambos estimadores de B_0 y B_1. Este procedimiento requiere que tengamos en cuenta la suposición de normalidad sobre los errores.
Para calcular de forma automática los intervalos de confianza sobre
los parámetros, \(\beta_0\) y \(\beta_1\) podemos usar la función
confint de R, dentro de esta función podemos especificar el
nivel de confianza requerido:
#recordar que los intervalos de confianza de B0 y B1 se sacan con un estadistico T-student
round(confint(lm,level=0.98),3)
## 1 % 99 %
## (Intercept) 1679.858 1938.249
## X -1750.731 -1373.900
Ya sabemos el intervalo de confianza en un 98% de los parámetros de nuestro modelo.
Vamos a proceder a hacer inferencias sobre la variable respuesta, es decir, sobre los puntos. Es una manera interesante de emplear el modelo visto.
El atleta con id 108588 es el que hizo más puntos, veamos quien es:
nadadoresPruebas[nadadoresPruebas$athleteid==108588 , ]
## athleteid lastname firstname birthdate gender name code eventid
## 1077 108588 PEATY ADAM 1994-12-28 M Great Britain GBR 6
## 1078 108588 PEATY ADAM 1994-12-28 M Great Britain GBR 206
## 1079 108588 PEATY ADAM 1994-12-28 M Great Britain GBR 106
## 1080 108588 PEATY ADAM 1994-12-28 M Great Britain GBR 14
## 1081 108588 PEATY ADAM 1994-12-28 M Great Britain GBR 214
## 1082 108588 PEATY ADAM 1994-12-28 M Great Britain GBR 114
## 1083 108588 PEATY ADAM 1994-12-28 M Great Britain GBR 26
## heat lane points reactiontime swimtime split cumswimtime splitdistance
## 1077 9 4 996 0.60 58.52 1 27.05 50
## 1078 2 4 1014 0.60 58.18 1 27.21 50
## 1079 1 4 996 0.59 58.52 1 27.20 50
## 1080 9 4 993 0.60 26.68 1 26.68 50
## 1081 1 4 1022 0.59 26.42 1 26.42 50
## 1082 1 4 1012 0.57 26.51 1 26.51 50
## 1083 5 5 866 0.61 133.24 1 29.77 50
## daytime round distance relaycount stroke splitswimtime edad
## 1077 1134 PRE 100 1 BREAST 27.05 20
## 1078 1835 SEM 100 1 BREAST 27.21 20
## 1079 1732 FIN 100 1 BREAST 27.20 20
## 1080 930 PRE 50 1 BREAST 26.68 20
## 1081 1748 SEM 50 1 BREAST 26.42 20
## 1082 1810 FIN 50 1 BREAST 26.51 20
## 1083 1033 PRE 200 1 BREAST 29.77 20
Viendo esto supongamos que queremos predecir para un nuevo valor de X, es decir, el tiempo de reacción de 0,57 del nadador anterior y ver sus puntos. Vemos como calcular con R esta predicción de forma automática:
#hacerlo directamente
new1 <- data.frame(X=0.57)
#new1
predict(lm,newdata=new1,se.fit=TRUE)
## $fit
## 1
## 918.5334
##
## $se.fit
## [1] 10.55179
##
## $df
## [1] 829
##
## $residual.scale
## [1] 154.3074
#primera fila sale la esperanza de la estimacion puntual, y en la segunda sale la raiz de la varianza de la estimacion
Según los resultados teóricos que hemos visto, esta predicción media sigue una distribución normal, con valor esperado y con varianza estimada:
Justo el valor s.predic es el que nos devuelve la
función predict de R, para 0.57. Comprobamos si es
consistente con el nadador
nadadoresPruebas[nadadoresPruebas$athleteid==108588 , ]
## athleteid lastname firstname birthdate gender name code eventid
## 1077 108588 PEATY ADAM 1994-12-28 M Great Britain GBR 6
## 1078 108588 PEATY ADAM 1994-12-28 M Great Britain GBR 206
## 1079 108588 PEATY ADAM 1994-12-28 M Great Britain GBR 106
## 1080 108588 PEATY ADAM 1994-12-28 M Great Britain GBR 14
## 1081 108588 PEATY ADAM 1994-12-28 M Great Britain GBR 214
## 1082 108588 PEATY ADAM 1994-12-28 M Great Britain GBR 114
## 1083 108588 PEATY ADAM 1994-12-28 M Great Britain GBR 26
## heat lane points reactiontime swimtime split cumswimtime splitdistance
## 1077 9 4 996 0.60 58.52 1 27.05 50
## 1078 2 4 1014 0.60 58.18 1 27.21 50
## 1079 1 4 996 0.59 58.52 1 27.20 50
## 1080 9 4 993 0.60 26.68 1 26.68 50
## 1081 1 4 1022 0.59 26.42 1 26.42 50
## 1082 1 4 1012 0.57 26.51 1 26.51 50
## 1083 5 5 866 0.61 133.24 1 29.77 50
## daytime round distance relaycount stroke splitswimtime edad
## 1077 1134 PRE 100 1 BREAST 27.05 20
## 1078 1835 SEM 100 1 BREAST 27.21 20
## 1079 1732 FIN 100 1 BREAST 27.20 20
## 1080 930 PRE 50 1 BREAST 26.68 20
## 1081 1748 SEM 50 1 BREAST 26.42 20
## 1082 1810 FIN 50 1 BREAST 26.51 20
## 1083 1033 PRE 200 1 BREAST 29.77 20
Por tanto el intervalo de confianza al 98% de confianza para el valor esperado de las ventas con el valor X=0.57 , es:
#intervalos t student para el valor medio para x0
#y.hat-qt(0.99,n-2)*s.predic
#y.hat+qt(0.99,n-2)*s.predic
VISUALIZAR TIPOS DE NADADORES VIENDO LOS PARCIALES
Veamos qué nadadores nadaron el 800 libre femenino:
nadadoras800free<-nadadoresPruebas[nadadoresPruebas$distance==800 & nadadoresPruebas$gender=="F", ]
dim(nadadoras800free)
## [1] 51 23
Tenemos que 52 chicas nadaron el 800 libres, algunas de ellas dos veces ya que pasaron a la final.
Nos vamos a fijar en la final, para ello, filtramos otra vez los datos:
nadadoras800free<-datos2015[datos2015$gender=="F" & datos2015$distance==800 & datos2015$round=="FIN", ]
Ahora, vamos a definir una tabla en la que nos va a importar el nombre, la suma total de tiempo al paso de cada parcial:
nadadoras800free <- nadadoras800free %>%
dplyr::select(lastname,firstname,gender,reactiontime,splitdistance,cumswimtime, swimtime)
Ahora vamos a representar cómo fue la carrera:
# Ordenar los datos por tiempo
nadadoras800free <- nadadoras800free %>%
arrange(splitdistance, cumswimtime)
# Crear un índice de posición
nadadoras800free <- nadadoras800free %>%
group_by(splitdistance) %>%
mutate(Posicion = rank(cumswimtime, ties.method = "first"))
ggplot(nadadoras800free, aes(x = splitdistance, y = Posicion, group = lastname)) +
geom_line(aes(color = lastname, alpha = 1), size = 2) +
geom_point(aes(color = lastname, alpha = 1), size = 4) +
scale_y_reverse(breaks = 1:nrow(nadadoras800free))
## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
## ℹ Please use `linewidth` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
Observamos como Ledecky lidera toda la carrera, Boyle alcanza al paso de los 100 metros la segunda posición y la mantiene. La pelea por la última medalla en juego dura hasta los 700 metros, donde un adelantamiento de Carlin a Ashwood hace que la nadadora Jaz Carlin alcance el bronce olímpico.
Realizaremos ahora el análisis de componentes principales del 800m libres femenino:
Lo primero que debemos hacer es cargar los datos:
prueba800libresPreliminar<- datos2015[datos2015$distance==800 & datos2015$gender=="F" & datos2015$stroke=="FREE" & datos2015$round=="PRE", ]
prueba800libresPreliminar <- prueba800libresPreliminar %>%
dplyr::select(lastname, reactiontime, splitdistance, splitswimtime, edad, swimtime)
Bien, ahora, debemos encontrar la manera de crear una tabla en la que nos quedemos con el nombre, apellido y parciales
pruebawide <- prueba800libresPreliminar %>%
pivot_wider(names_from = splitdistance, # Los valores de 'Split' serán los nombres de las columnas
values_from =splitswimtime) # Los valores de 'Tiempo' llenarán las celdas
pruebawide
## # A tibble: 44 × 20
## lastname reactiontime edad swimtime `50` `100` `150` `200` `250` `300`
## <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 HOLOWCHAK 0.71 14 578. 32.4 35.9 35.0 36.4 35.9 36.2
## 2 VAN DEN BERG 0.79 19 544. 31.6 33.9 34.1 34.2 33.7 33.9
## 3 ASHWOOD 0.78 22 502. 29.2 31.4 31.8 31.9 31.9 32.0
## 4 NEALE 0.73 20 524. 29.5 32.5 33.2 32.9 32.7 32.8
## 5 EVANS 0.79 18 530. 30 32.3 33.0 32.8 33.0 32.9
## 6 GILL 0.9 16 556. 31.2 34.5 34.6 34.6 34.6 35.0
## 7 KOBRICH 0.81 30 513. 30.3 31.9 32.2 32.2 32.2 32.2
## 8 ZHANG 0.72 20 515. 29.6 31.8 32.4 32.1 32.5 32.4
## 9 CAO 0.82 19 523. 29.6 32.6 32.7 32.5 32.5 32.4
## 10 TE FLAN 0.84 20 557. 30.4 34.3 33.8 34.9 34.8 35.4
## # ℹ 34 more rows
## # ℹ 10 more variables: `350` <dbl>, `400` <dbl>, `450` <dbl>, `500` <dbl>,
## # `550` <dbl>, `600` <dbl>, `650` <dbl>, `700` <dbl>, `750` <dbl>,
## # `800` <dbl>
#omito los valores nulos:
pruebawide<- na.omit(pruebawide)
Ahora que ya tenemos nuestra tabla hecha, vamos a hacer el PCA:
prcomp(pruebawide[,-1], scale=T)
## Standard deviations (1, .., p=19):
## [1] 4.023586e+00 1.041304e+00 7.785392e-01 7.382862e-01 5.062993e-01
## [6] 3.175665e-01 2.611707e-01 2.165205e-01 1.687247e-01 1.581588e-01
## [11] 1.075632e-01 9.255086e-02 8.565307e-02 8.227024e-02 7.435885e-02
## [16] 6.567891e-02 5.874500e-02 4.421473e-02 6.243525e-15
##
## Rotation (n x k) = (19 x 19):
## PC1 PC2 PC3 PC4 PC5
## reactiontime 0.05983445 -0.8548805654 0.389663026 0.322580871 -0.03846734
## edad -0.14420441 -0.4270382355 -0.866772516 -0.015784712 0.19496962
## swimtime 0.24840925 0.0018930275 -0.038793720 0.009020956 0.01313956
## 50 0.21182284 -0.1853751565 -0.043219556 -0.540855385 -0.43698792
## 100 0.23538350 -0.0907464381 0.016938389 -0.325049600 -0.11601195
## 150 0.23501269 -0.1223046598 0.043502842 -0.306174334 -0.01148184
## 200 0.24430259 -0.0437109209 -0.044182489 -0.184195752 0.05061937
## 250 0.24361585 -0.0451981883 0.007677022 -0.160730518 0.14171315
## 300 0.24440198 -0.0069167981 -0.025301932 -0.098672387 0.20110567
## 350 0.24503556 -0.0006221791 0.022977429 -0.057023203 0.19566506
## 400 0.24410435 0.0333231893 -0.025358474 0.057684193 0.29667052
## 450 0.24506432 0.0033041538 0.045257296 0.072686308 0.17409277
## 500 0.24299693 0.0700572797 -0.029078030 0.132635928 0.24311819
## 550 0.24424506 0.0373771564 -0.012016814 0.124587211 0.12690538
## 600 0.24221130 0.0448875453 -0.036353393 0.224613771 0.12099054
## 650 0.24469227 0.0447632311 -0.074047504 0.138000290 -0.04086327
## 700 0.24190935 0.0690021714 -0.102682090 0.184190234 -0.07722008
## 750 0.23676854 0.0398647852 -0.109127194 0.227346339 -0.29580496
## 800 0.21940512 0.0863676456 -0.234943599 0.366201338 -0.59254285
## PC6 PC7 PC8 PC9 PC10
## reactiontime -0.063195170 -0.0082037890 -0.027261339 -0.0016185936 -0.013706516
## edad 0.049610378 0.0091059834 0.037134780 0.0082633099 -0.016282748
## swimtime 0.004375565 -0.0001518283 0.004018174 -0.0000164062 -0.001791597
## 50 -0.083936423 0.6029254662 -0.112580798 -0.0542177292 0.134484205
## 100 -0.274392364 -0.2654045882 0.559672194 0.1782529220 -0.411537558
## 150 0.399102735 -0.3880509028 0.119027135 0.1056319149 0.596281461
## 200 -0.084192806 -0.2763554468 -0.012860354 0.0005079185 -0.263630849
## 250 0.046347446 -0.2520769903 -0.416609441 -0.1902363766 0.049400583
## 300 -0.273699137 -0.1387599719 -0.306760180 -0.1543679179 0.028181054
## 350 0.174796679 0.1189619862 -0.347177480 -0.0282402422 -0.341403528
## 400 -0.187550965 0.0608426167 -0.056866041 0.1756736191 0.029860156
## 450 0.261952390 0.1882345522 0.025926550 0.1103509522 -0.220980563
## 500 -0.183306103 0.1010521495 0.193881639 0.1581073538 0.328168458
## 550 0.261662267 0.2091398836 0.063383275 0.4632193547 -0.043855930
## 600 -0.165779826 0.2047619545 0.286142397 -0.2149848457 0.266033214
## 650 0.189632658 0.2160751329 0.082816039 -0.0711693751 -0.094539081
## 700 -0.349314987 -0.0065514167 0.056881265 -0.4184599698 0.065995191
## 750 0.464901944 -0.1257122111 0.188225385 -0.4519056822 -0.145525042
## 800 -0.172464419 -0.2108046793 -0.310661057 0.4242882424 0.051621095
## PC11 PC12 PC13 PC14 PC15
## reactiontime 0.017157517 0.007402468 -0.047817231 -0.0003607183 -0.0141725491
## edad -0.028951269 -0.015255251 0.035975911 -0.0004663109 -0.0222429740
## swimtime -0.004025308 0.002249907 0.002686181 0.0011709719 -0.0003402032
## 50 -0.023328313 -0.073023925 -0.083636174 -0.0497595305 0.0759129808
## 100 -0.031932394 -0.146836412 0.108261191 0.0595586571 -0.1801573633
## 150 -0.179234745 0.243422657 0.078739615 0.1410167578 0.0215539004
## 200 0.237443162 0.303715720 -0.173928745 -0.2326106456 0.3440681146
## 250 0.257982282 -0.441472149 0.147110574 0.1040156908 -0.3021658160
## 300 0.194208084 0.001201102 0.111489411 -0.1909065180 0.1173612294
## 350 -0.354621602 0.153192335 -0.068244871 -0.1238192088 -0.0508881961
## 400 -0.168895228 0.084413979 -0.430298623 0.4288707302 0.3530049172
## 450 -0.380719908 0.101168840 0.497332270 -0.1401229061 -0.0609655088
## 500 -0.114885618 -0.125517009 -0.388515662 -0.5231952430 -0.4160174056
## 550 0.264968556 -0.456275412 0.023018804 0.2589871234 0.1351201076
## 600 0.208542052 0.025584161 0.433774981 -0.1657569272 0.3886263900
## 650 0.507712894 0.528529427 -0.077452302 0.2181994917 -0.4406317400
## 700 -0.337433689 -0.021990634 0.063574768 0.4523953590 -0.1821545368
## 750 -0.055556675 -0.274747595 -0.327348943 -0.1563522693 0.1910092196
## 800 -0.060534196 0.075357905 0.114836302 -0.0939134966 0.0078194198
## PC16 PC17 PC18 PC19
## reactiontime 0.007948326 -0.0103916468 -0.0148731181 2.863989e-17
## edad 0.004989834 -0.0050530472 0.0109296613 1.141866e-16
## swimtime 0.001237888 0.0004177849 0.0001344139 -9.677087e-01
## 50 -0.063988407 0.0457256906 -0.0446836490 4.311951e-02
## 100 -0.011539716 -0.0919004464 0.2733433758 5.705533e-02
## 150 0.095622896 -0.1127473817 0.0104327205 5.835630e-02
## 200 0.167205762 0.3401893583 -0.4978625270 6.259020e-02
## 250 -0.078497830 0.4461470952 0.1440946650 5.964962e-02
## 300 -0.272777505 -0.7042463275 -0.0444851730 6.158309e-02
## 350 0.556324342 -0.1140434999 0.3414701323 6.628547e-02
## 400 -0.366611180 0.1686579366 0.2770910832 6.689849e-02
## 450 -0.473273673 0.1462805303 -0.2462462376 6.828580e-02
## 500 0.010935972 0.0674091654 -0.0930329990 6.621820e-02
## 550 0.265474278 -0.2203881315 -0.2946123376 6.599382e-02
## 600 0.219513694 0.1812683844 0.3288916491 6.783824e-02
## 650 -0.089448365 -0.0535132537 0.0903355175 6.713924e-02
## 700 0.226121531 -0.0460720605 -0.4091797254 6.791318e-02
## 750 -0.178833971 -0.0986336674 0.0770640054 6.468079e-02
## 800 -0.015074279 0.0483881743 0.1142834894 5.978394e-02
summary(prcomp(pruebawide[,-1],scale=T))
## Importance of components:
## PC1 PC2 PC3 PC4 PC5 PC6 PC7
## Standard deviation 4.0236 1.04130 0.7785 0.73829 0.50630 0.31757 0.26117
## Proportion of Variance 0.8521 0.05707 0.0319 0.02869 0.01349 0.00531 0.00359
## Cumulative Proportion 0.8521 0.90913 0.9410 0.96972 0.98322 0.98852 0.99211
## PC8 PC9 PC10 PC11 PC12 PC13 PC14
## Standard deviation 0.21652 0.1687 0.15816 0.10756 0.09255 0.08565 0.08227
## Proportion of Variance 0.00247 0.0015 0.00132 0.00061 0.00045 0.00039 0.00036
## Cumulative Proportion 0.99458 0.9961 0.99740 0.99800 0.99846 0.99884 0.99920
## PC15 PC16 PC17 PC18 PC19
## Standard deviation 0.07436 0.06568 0.05875 0.04421 6.244e-15
## Proportion of Variance 0.00029 0.00023 0.00018 0.00010 0.000e+00
## Cumulative Proportion 0.99949 0.99972 0.99990 1.00000 1.000e+00
Viendo el pca, observamos que con la primera componente, tenemos un 85% de la varianza. Con pc2 un 5%, luego con esas dos podemos explicar un 90% de los datos.
(aquí sacar conclusiones pero primero preguntar mañana a Carmen)
Ahora, veamos cómo se ven los datos:
plot(prcomp(pruebawide[,-1],scale=T)$x[,1:2])
kmedias=kmeans(prcomp(pruebawide[,-1],scale=T)$x[,1:2], centers=2, nstar=25)
kmedias
## K-means clustering with 2 clusters of sizes 12, 31
##
## Cluster means:
## PC1 PC2
## 1 5.397291 0.3097230
## 2 -2.089274 -0.1198928
##
## Clustering vector:
## [1] 1 1 2 2 2 1 2 2 2 1 2 1 2 2 2 2 2 1 2 2 2 2 2 2 2 2 1 1 2 2 2 2 2 1 2 2 1 1
## [39] 1 2 2 2 2
##
## Within cluster sum of squares by cluster:
## [1] 123.1387 115.8681
## (between_SS / total_SS = 67.1 %)
##
## Available components:
##
## [1] "cluster" "centers" "totss" "withinss" "tot.withinss"
## [6] "betweenss" "size" "iter" "ifault"